home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacWorld: Complete Mac Interactive
/
Macworld Complete Mac Interactive CD)(1994).iso
/
The Best of BMUG
/
Utilities
/
Text and Speech
/
Alpha.5.76
/
Tcl
/
SystemCode
/
strings.tcl
< prev
next >
Wrap
Text File
|
1994-03-08
|
2KB
|
64 lines
#=============================================================================
# 'Strings' commands - Thanks, Mark Nagata
#=============================================================================
proc setPrefix {} {
global prefixString
if {[catch {prompt "New Prefix String:" $prefixString} res] == 1} return
set prefixString $res
}
proc setSuffix {} {
global suffixString
if {[catch {prompt "New Suffix String:" $suffixString} res] == 1} return
set suffixString $res
}
proc insertSuffix {} {doSuffix insert}
proc removeSuffix {} {doSuffix remove}
proc doSuffix {which} {
global suffixString
set suff [quoteExpr $suffixString]
set pts [getEndpts]
set start [lindex $pts 0]
set end [lindex $pts 1]
set start [lineStart $start]
set end [nextLineStart [expr $end-1]]
set text [getText $start $end]
deleteText $start $end
if {$which == "insert"} then {
set str ${suffixString}\r
regsub -all \r $text $str text
} else {
set str ${suff}\r
regsub -all $str $text \r text
}
insertText $text
select $start [expr {$start+[string length $text]}]
}
proc insertPrefix {} {doPrefix insert}
proc removePrefix {} {doPrefix remove}
proc doPrefix {which} {
global prefixString
set pref [quoteExpr $prefixString]
if {[set start [getPos]] == [set end [selEnd]]} {
set end [nextLineStart $start]
}
set start [lineStart $start]
if {[lookAt [expr $end-1]] == "\r"} {incr end -1}
set text [getText $start $end]
if {$which == "insert"} then {
set str \r$prefixString
regsub -all \r $text $str text
replaceText $start $end $prefixString$text
} else {
regsub -all \r$pref $text \r text
regsub -all ^$pref $text "" text
replaceText $start $end $text
}
select $start [nextLineStart [getPos]]
}